perm filename COMPLR.BUG[ML,DWP] blob
sn#026346 filedate 1974-04-30 generic text, type T, neo UTF8
(DEFPROP STORE_PROP
(LAMBDA (ATM VAL IND)
(PROG (_G)
(SETQ _G (GET (QUOTE PROPERTIES) (QUOTE ARRAY)))
(STORE (_G (CADDR ATM)) (APPEND (LIST IND VAL) (_G (CADDR ATM))))))
EXPR)
(DEFPROP COMPUTE_PAST_DUE
(LAMBDA (NAME)
(PROG (PAST_DUE)
(PRINTSTRTTY (CAT (QUOTE "Is there any past due for ") (CAT NAME (QUOTE "?"))))
(COND ((EQ (READ) (QUOTE no)) (RETURN 0)))
(SETQ PAST_DUE 0)
(PRINTSTRTTY (QUOTE "Do you want to itemize the amounts month by month?"))
(COND ((EQ (READ) (QUOTE yes))
(PROG (MONTH)
(TERPRI (PRINTSTR (TERPRI (QUOTE "Past due:"))))
(PRINTSTRTTY
(QUOTE
"Type the month, followed by a carriage return.
Type done when there are no more months."))
(PROG (&V)
LOOP (COND ((NOT (EQ (SETQ MONTH (READ)) (QUOTE done)))
(SETQ &V
(PROG (AMOUNT)
(PRINTSTRTTY (QUOTE "Amount ="))
(PRINTSTR
(CHOP (SPACE (CAT (QUOTE " ") MONTH))
(DOLLARS (SETQ AMOUNT (READ)))))
(SETQ PAST_DUE (*PLUS PAST_DUE AMOUNT))
(PRINTSTRTTY (QUOTE "Next month (or done) =")))))
(T (RETURN &V)))
(GO LOOP))))
(T (PROG NIL
(PRINTSTRTTY (QUOTE "Amount past due ="))
(TERPRI
(PRINTSTR
(TERPRI
(CHOP (SPACE (QUOTE "Past due")) (DOLLARS (SETQ PAST_DUE (READ))))))))))
(RETURN PAST_DUE)))
EXPR)